home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / TPL60N14.ARJ / HEAPTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1992-05-01  |  4KB  |  128 lines
  1. PROGRAM HeapTest;  { Copyright (c) 1991,92 Norbert Juffa }
  2.  
  3. {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R-,S-,V-,X-}
  4. {$M 4096,0,655360}
  5.  
  6. USES Time;
  7.  
  8. VAR Dummy,Start, LoopTime,LoopTime2: LONGINT;
  9.     L,Choice,K,T: WORD;
  10.     BlkPtr:  ARRAY [1..1000] OF POINTER;
  11.     BlkSize: ARRAY [1..1000] OF WORD;
  12.     Permutation: ARRAY [1..1000] OF WORD;
  13.  
  14. BEGIN
  15.    RandSeed := 997;
  16.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  17.    Start := Clock;
  18.    FOR L := 1 TO 1000 DO BEGIN
  19.    END;
  20.    LoopTime := Clock-Start;
  21.    FOR L := 1 TO 1000 DO BEGIN
  22.       BlkSize [L] := Random (512) + 1;
  23.    END;
  24.    Write ('Allocating 1000 blocks at the end of the heap: ');
  25.    Start := Clock;
  26.    FOR L := 1 TO 1000 DO BEGIN
  27.       GetMem (BlkPtr [L], BlkSize [L]);
  28.    END;
  29.    WriteLn (Clock-Start-LoopTime:4, ' ms');
  30.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  31.    Write ('Deallocating same 1000 blocks in reverse order:');
  32.    Start := Clock;
  33.    FOR L := 1 TO 1000 DO BEGIN
  34.       FreeMem (BlkPtr [L], BlkSize [L]);
  35.    END;
  36.    WriteLn (Clock-Start-LoopTime:4, ' ms');
  37.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  38.    Write ('Allocating 1000 blocks at the end of the heap: ');
  39.    Start := Clock;
  40.    FOR L := 1 TO 1000 DO BEGIN
  41.       GetMem (BlkPtr [L], BlkSize [L]);
  42.    END;
  43.    WriteLn (Clock-Start-LoopTime:4, ' ms');
  44.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  45.    FOR L := 1 TO 1000 DO BEGIN
  46.       Permutation [L] := L;
  47.    END;
  48.    Start := Clock;
  49.    FOR L := 1000 DOWNTO 1 DO BEGIN
  50.       Choice := Random (L)+1;
  51.       K := Permutation [Choice];
  52.       Permutation [Choice] := Permutation [L];
  53.    END;
  54.    LoopTime2 := Clock - Start;
  55.    FOR L := 1 TO 1000 DO BEGIN
  56.       Permutation [L] := L;
  57.    END;
  58.    Write ('Deallocating same 1000 blocks at random:       ');
  59.    Start := Clock;
  60.    FOR L := 1000 DOWNTO 1 DO BEGIN
  61.       Choice := Random (L)+1;
  62.       K := Permutation [Choice];
  63.       Permutation [Choice] := Permutation [L];
  64.       FreeMem (BlkPtr [K], BlkSize [K]);
  65.    END;
  66.    WriteLn (Clock-Start-LoopTime2:4, ' ms');
  67.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  68.    Write ('Allocating 1000 blocks at the end of the heap: ');
  69.    Start := Clock;
  70.    FOR L := 1 TO 1000 DO BEGIN
  71.       GetMem (BlkPtr [L], BlkSize [L]);
  72.    END;
  73.    WriteLn (Clock-Start-LoopTime:4, ' ms');
  74.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  75.    FOR L := 1 TO 1000 DO BEGIN
  76.       Permutation [L] := L;
  77.    END;
  78.    Start := Clock;
  79.    FOR L := 1000 DOWNTO 1 DO BEGIN
  80.       Choice := Random (L)+1;
  81.       K := Permutation [Choice];
  82.       T:= Permutation [L];
  83.       Permutation [L] := Permutation [Choice];
  84.       Permutation [Choice] := T;
  85.    END;
  86.    LoopTime2 := Clock - Start;
  87.    FOR L := 1 TO 1000 DO BEGIN
  88.       Permutation [L] := L;
  89.    END;
  90.    Write ('Deallocating 500 blocks at random:             ');
  91.    Start := Clock;
  92.    FOR L := 1000 DOWNTO 501 DO BEGIN
  93.       Choice := Random (L)+1;
  94.       K := Permutation [Choice];
  95.       T:= Permutation [L];
  96.       Permutation [L] := Permutation [Choice];
  97.       Permutation [Choice] := T;
  98.       SYSTEM.FreeMem (BlkPtr [K], BlkSize [K]);
  99.    END;
  100.    WriteLn (Clock-Start-LoopTime2:4, ' ms');
  101.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  102.    Start := Clock;
  103.    FOR L := 1 TO 1000 DO BEGIN
  104.       Dummy := MaxAvail;
  105.    END;
  106.    WriteLn ('1000 calls to MaxAvail:                        ', Clock-Start, ' ms');
  107.    Start := Clock;
  108.    FOR L := 1 TO 1000 DO BEGIN
  109.       Dummy := MemAvail;
  110.    END;
  111.    WriteLn ('1000 calls to MemAvail:                        ', Clock-Start, ' ms');
  112.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  113.    Write ('Reallocating deallocated 500 blocks at random: ');
  114.    Start := Clock;
  115.    FOR L := 501 TO 1000 DO BEGIN
  116.       GetMem (BlkPtr [Permutation [L]], BlkSize [Permutation [L]]);
  117.    END;
  118.    WriteLn (Clock-Start-LoopTime:4, ' ms');
  119.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  120.    Write ('Deallocating all 1000 blocks at random:        ');
  121.    Start := Clock;
  122.    FOR L := 1000 DOWNTO 1 DO BEGIN
  123.       FreeMem (BlkPtr [L], BlkSize [L]);
  124.    END;
  125.    WriteLn (Clock-Start-LoopTime:4, ' ms');
  126.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  127. END. { HeapTest }
  128.